﻿module JsEval

open FParsec
open JsAst
open JsParser
open JsTypes


(*
Js spec:
http://www.ecma-international.org/ecma-262/5.1/
*)

exception TypeError of string

let PutValue(ref, value) = 
    match ref with
    | PropertyReference(obj, propname) ->
        match obj with
        | Object(obj) -> obj.Put propname value
        | _ -> failwith "Not an object"
    | EnvironmentReference(Some(record), propname) ->
        record.SetMutableBinding(propname, value)
    | EnvironmentReference(None, propname) ->
        // here we should add to the global object!
        failwith "Global not supported yet"

let executeBinaryOperator op left right =
    match op with 
    | "+" ->
        let lprim = ToPrimitive left NoHint
        let rprim = ToPrimitive right NoHint
        match lprim, rprim with
        | (StringValue(l),StringValue(r)) -> StringValue(l + r)
        | (_,_) -> Number(ToNumber(lprim) + ToNumber(rprim))
    | "-" -> Number(ToNumber(left) - ToNumber(right))
    | "*" -> Number(ToNumber(left) * ToNumber(right))
    | "/" -> Number(ToNumber(left) / ToNumber(right))
    | "%" -> Number(ToNumber(left) % ToNumber(right))

let incdec op oldValue =
    let num = ToNumber(oldValue)
    let newValue = 
        match op with
        | "++" -> num + 1.0
        | "--" -> num - 1.0
    Number(newValue)

type StatementResult = 
        | NoValue
        | Value of JsValue
        | Return of JsValue

let rec evalExpr expr (env:Environment) = 
    match expr with
    (* literals *)
    | StringLiteral(str) -> StringValue(str)
    | NumberLiteral(num) -> Number(num)
    | BooleanLiteral(b) -> Boolean(b)
    | NullLiteral -> NullValue
    (* expressions *)
    | NewExpression(leftExpr, argsExprs) ->
        let ctor = evalExpr leftExpr env
        let argVals = [for argExpr in argsExprs -> evalExpr argExpr env]
        match ctor with
        | Object(obj) -> obj.Construct(argVals)
        | _ -> raise(TypeError("Not a constructor"))         
    | CallExpression(leftExpr, argExprs) ->
        let leftVal = evalExpr leftExpr env
        let argVals = [for argExpr in argExprs -> evalExpr argExpr env]
        call leftVal argVals env
    | PropertyExpression(leftExpr, propName) ->
        let leftVal = evalExpr leftExpr env
        match leftVal with
        | Object(obj) ->  obj.Get propName
        (* todo: properties på primitive wrappers *)
        | _ -> Undefined
    | Name(name) -> 
        match env.getReference name with
        | EnvironmentReference(None, name) -> failwith ("Name not found " + name)
        | EnvironmentReference(Some(record), name) ->
            record.GetBindingValue(name)
    | FunctionExpression(parms, stmts) ->
        Object(NativeFunction(env, parms, stmts, evalFunctionBody))
    | BinaryOperation(op, leftEx, rightEx) ->        
        executeBinaryOperator op (evalExpr leftEx env) (evalExpr rightEx env)
    | UnaryOperation(op, expr) ->        
        let value = evalExpr expr env
        match op with 
        | "+" -> Number(ToNumber(value))
        | "-" -> Number(-ToNumber(value))
        | "!" -> Boolean(not (ToBoolean(value)))
        | "void" -> Undefined
        | "typeof" ->
            let str =
                match value with
                | Undefined -> "undefined"
                | NullValue -> "object"
                | Boolean(_) -> "boolean"
                | Number(_) -> "number"
                | StringValue(_) -> "string"
                | Object(obj) ->
                    if obj.ImplementsCall
                    then "function"
                    else "object" // TODO: should get custom string from host object
            StringValue(str)
    | AssignmentExpression(leftEx, rightEx) ->
        let ref = GetRefAssignable leftEx env  
        let rval = evalExpr rightEx env
        do PutValue(ref, rval)
        rval    
    | PostfixMutate(op, expr) ->    
        let ref = GetRefAssignable expr env            
        let oldValue = evalExpr expr env
        let newValue = incdec op oldValue
        do PutValue(ref, newValue)
        oldValue
    | PrefixMutate(op, expr) ->    
        let ref = GetRefAssignable expr env        
        let oldValue = evalExpr expr env
        let newValue = incdec op oldValue
        do PutValue(ref, newValue)
        newValue


and call leftVal args (env:Environment) =
    match leftVal with    
    | Object(obj) -> obj.Call Undefined args
    | _ -> failwith "Not a function"

and evalStmt statement (env:Environment) = 
    match statement with
    | FunctionDeclaration(_,_,_) -> NoValue
    | ExpressionStatement(expr) -> 
        Value(evalExpr expr env)
    | VariableStatement(vars) ->
        for (varname, initializerExpr) in vars do
            let initialValue =
                match initializerExpr with
                | Some expr -> evalExpr expr env
                | None -> Undefined
            do env.record.SetMutableBinding(varname, initialValue)
        NoValue
    | IfStatement(cond, stmts) ->
        if ToBoolean(evalExpr cond env)
        then evalStmts stmts env
        else Value(Undefined)
    | IfElseStatement(cond, stmts, stmts2) ->
        if ToBoolean(evalExpr cond env)
        then evalStmts stmts env
        else evalStmts stmts2 env
    | ReturnStatement(mexpr) -> 
        let returnVal =
            match mexpr with
            | None -> Undefined
            | Some expr -> evalExpr expr env
        Return(returnVal)

(* 
    Eval a set of statements
    That would either be top-level code or a function body
    Two passes:
    (1) All var-statements and function declarations are visited.
        functions are defined, and var's are defined as 'undefined'
    (2) Actual execution
*)
and evalStmts stmts (env:Environment) : StatementResult = 
    (* first pass: visit all fundecls and vardecls *)
    let rec definitionPass stmts =
        stmts |> List.iter definitionPassNode

    and definitionPassNode stmt : unit =
        match stmt with
        | ExpressionStatement(_) | ReturnStatement(_)  -> ()
        | IfStatement(cond, stmts) -> definitionPass stmts
        | IfElseStatement(cond, stmts, stmts2) -> 
            do definitionPass stmts
            do definitionPass stmts2
        | FunctionDeclaration(name, prms, body) ->
            // name might already be defined, we just override
            let funObj = Object(NativeFunction(env, prms, body, evalFunctionBody))
            do env.record.SetMutableBinding(name, funObj)
        | VariableStatement(decls) ->
            for name, _ in decls do
                // might already be defined
                env.record.SetMutableBinding(name, Undefined)                

    let rec eval1 stmts prevVal = 
        match stmts with
        | [] -> prevVal
        | (stmt::rest) ->                    
            let res = evalStmt stmt env
            match res with             
            | Return(x) -> res
            | NoValue | Value(_) ->
                match rest with
                | [] -> res
                | _ -> eval1 rest res

    do definitionPass stmts
    eval1 stmts (Value(Undefined))

and evalFunctionBody statements (env:Environment) = 
    match evalStmts statements env with
    | Return(x) -> x
    | Value(_) | NoValue -> Undefined

and GetRef expr env : Reference option = 
    match expr with
    | PropertyExpression(lexpr, propertyName) ->
        let baseReference = evalExpr lexpr env
        Some(PropertyReference(baseReference, propertyName))
    | BracketsExpression(lexpr, expr) ->
        let baseReference = evalExpr expr env
        let rvalue = evalExpr expr env
        Some(PropertyReference(baseReference, ToString(rvalue)))
    | Name(name) ->  Some(env.getReference name)
    | _ -> None
    (* in theory a function could also return a reference, but
       this is only relevat for exotic host objects *)

and GetRefAssignable expr env =
    match GetRef expr env with
    | None -> failwith "Not assignable"
    | Some ref -> ref


